home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
os2
/
lopbk505.zip
/
LBKMOD2.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1997-03-25
|
28KB
|
1,719 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Boolean TBOOLEAN003(1)
Boolean BOOLEAN004
Boolean BOOLEAN005
Boolean BOOLEAN006
Boolean BOOLEAN007
Boolean BOOLEAN008
Date DATE001
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
Integer INTEGER006
Real REAL001
Real REAL002
Real REAL003
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
String STRING008
String STRING009
String STRING010
String STRING011
Time TIME001
Byte BYTE001
Byte BYTE002
Byte BYTE003
Byte BYTE004
Byte BYTE005
Byte BYTE006
;------------------------------------------------------------------------------
GetToken STRING003
GetToken STRING004
Select Case (STRING003)
Case "1"
Gosub LABEL024
Goto LABEL048
Case "2"
Gosub LABEL031
Goto LABEL048
Case "3"
STRING003 = ""
GetToken STRING003
If (STRING003 == "A") Then
BOOLEAN006 = 1
Gosub LABEL015
Goto LABEL048
Else
BOOLEAN006 = 0
Gosub LABEL015
Goto LABEL048
Endif
Case "4"
PrintLn
PrintLn "@X0FTrash file converting is no longer supported..."
PrintLn
Wait
Goto LABEL048
Case "5"
Gosub LABEL040
Goto LABEL048
Case "6"
Select Case (STRING004)
Case "C"
Gosub LABEL011
Case "V"
Gosub LABEL007
Case "A"
Gosub LABEL003
End Select
Goto LABEL048
Case "7"
Gosub LABEL001
Goto LABEL048
Case Else
PrintLn
PrintLn "@X0CLBKMOD2 : FATAL ERROR -- INVALID COMMAND PARAMETERS"
PrintLn
PrintLn "@X0ALBKMOD2.PPE can only be ran from within LOOPUTIL.PPE!"
PrintLn
Delay 9
Goto LABEL048
End Select
:LABEL001
Gosub LABEL042
PrintLn
STRING002 = PPEPath() + "TRASH.XPT"
STRING008 = PPEPath() + "EXPORT.RPT"
InputStr "Path & Filename to export to", STRING002, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 256
STRING002 = Strip(Upper(STRING002), " ")
If (STRING002 == "") Goto LABEL048
InputStr "Path & Filename for report file", STRING008, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 256
STRING008 = Strip(Upper(STRING008), " ")
If (STRING008 == "") Goto LABEL048
STRING001 = Trim(Upper(STRING001), " ")
If (Exist(STRING001)) Goto LABEL002
PrintLn
PrintLn "@X0C" + STRING001 + " does not exist!"
PrintLn
Delay 4
Goto LABEL048
:LABEL002
INTEGER001 = FileInf(STRING001, 4)
INTEGER002 = (INTEGER001 - 37) / 59
If (Exist(STRING002)) Then
FAppend 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Else
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Endif
FOpen 2, STRING001, 0, 0
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
If (Exist(STRING008)) Then
FAppend 3, STRING008, 1, 2
If (Ferr(3)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING008 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
FClose 3
Return
Endif
Else
FCreate 3, STRING008, 1, 2
If (Ferr(3)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING008 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
FClose 3
Return
Endif
FPutLn 3, "LoopBack v5.05 Already Used # Exportation Report"
FPutLn 3, "Report generated at " + String(Time()) + " on " + String(Date())
FPutLn 3, "----------------------------------------------------------------------"
FPutLn 3
Endif
INTEGER003 = 1
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FAlready Used # File Exportation Procedure@X0A)"
PrintLn
PrintLn
PrintLn "@X0BFrom :@X0E " + STRING001
PrintLn "@X0BTo :@X0E " + STRING002
PrintLn "@X0BReport :@X0E " + STRING008
PrintLn
Print "@X0CPlease wait, now exporting...@X0F "
FSeek 2, 37, 0
While (INTEGER003 <= INTEGER002) Do
FSeek 2, 1, 1
FRead 2, TBOOLEAN003(1), 1
FRead 2, STRING009, 3
STRING009 = Strip(STRING009, " ")
FRead 2, STRING011, 4
STRING011 = Strip(STRING011, " ")
FRead 2, STRING010, 8
STRING010 = Strip(STRING010, " ")
FSeek 2, 42, 1
If (TBOOLEAN003(1)) Then
FPutLn 3, "--------------------------------------------------------------------------"
FPutLn 3, "Record #" + String(INTEGER003) + " not exported because it is an international number..."
FPutLn 3, "CountryCode = " + STRING009
FPutLn 3, "CityCode = " + STRING011
FPutLn 3, "Number = " + STRING010
Else
FPutLn 1, STRING009 + "-" + Left(STRING011 + Space(3), 3) + "-" + Left(STRING010 + Space(4), 4)
Endif
Gosub LABEL046
Inc INTEGER003
EndWhile
FClose 1
FClose 2
FClose 3
PrintLn
PrintLn "@X0BExporting process completed!"
Log "Already Used # file exported...", 0
Delay 4
Return
:LABEL003
Gosub LABEL042
PrintLn
STRING008 = ""
STRING002 = ""
InputStr "Path & Filename of file to import", STRING002, 15, 45, Mask_Path() + Mask_File(), 2 + 4
STRING002 = Strip(Upper(STRING002), " ")
If (STRING002 == "") Goto LABEL048
STRING001 = Upper(STRING001)
Newline
InputStr "Name to place in file for all imported numbers", STRING008, 15, 25, Mask_Ascii(), 2 + 4
Newline
STRING008 = Trim(Upper(STRING008), " ")
PrintLn
If (Exist(STRING002)) Goto LABEL004
PrintLn "@X0C" + STRING002 + " does not exist!"
PrintLn
Delay 9
Return
:LABEL004
If (Exist(STRING001)) Then
FOpen 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
Else
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
Endif
FOpen 2, STRING002, 0, 0
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FAlready Used # Trash File Importation Procedure@X0A)"
PrintLn
PrintLn "@X0EFrom : @X0F" + STRING002
PrintLn "@X0ETo : @X0F" + STRING001
PrintLn "@X0EDefault Name : @X0F" + STRING008
PrintLn "@X0EFilter Type : @X0FASCII CR/LF DELIMITTED"
PrintLn
PrintLn
Print "@X0CImporting record #@X0F1"
INTEGER003 = 1
INTEGER005 = 1
:LABEL005
If (Ferr(2)) Goto LABEL006
FGet 2, STRING005
Backup Len(String(INTEGER005))
Print String(INTEGER003)
STRING005 = Strip(Strip(Strip(Strip(Strip(STRING005, " "), ")"), "("), "-"), ".")
If (STRING005 <> "") Then
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, Mid(STRING005, 1, 3), 3
FWrite 1, Mid(STRING005, 4, 3), 4
FWrite 1, Mid(STRING005, 7, 4), 8
FWrite 1, STRING008, 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
INTEGER005 = INTEGER003
Inc INTEGER003
Endif
Goto LABEL005
:LABEL006
FClose 1
FClose 2
PrintLn
PrintLn "@X0B" + STRING002 + " successfully imported..."
Log STRING002 + " imported into Used # file...", 0
PrintLn
Gosub LABEL040
Return
:LABEL007
Gosub LABEL042
PrintLn
STRING008 = ""
STRING002 = ""
InputStr "Path & Filename of file to import", STRING002, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 8
STRING002 = Strip(STRING002, " ")
If (STRING002 == "") Goto LABEL048
STRING001 = Upper(STRING001)
PrintLn
If (Exist(STRING002)) Goto LABEL008
PrintLn "@X0C" + STRING002 + " does not exist!"
PrintLn
Delay 9
Return
:LABEL008
If (Exist(STRING001)) Then
FOpen 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
Else
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
Endif
FOpen 2, STRING002, 0, 0
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FAlready Used # Trash File Importation Procedure@X0A)"
PrintLn
PrintLn "@X0EFrom : @X0F" + STRING002
PrintLn "@X0ETo : @X0F" + STRING001
PrintLn "@X0EFilter Type : @X0FPCBVERIFY/""THE VERIFY DOOR""/LOOPBACK"
PrintLn
PrintLn
Print "@X0CImporting record #@X0F1"
INTEGER003 = 1
INTEGER005 = 1
:LABEL009
If (Ferr(2)) Goto LABEL010
FGet 2, STRING005
STRING005 = Replace(STRING005, ",", ";")
STRING005 = Replace(STRING005, " ", Chr(255))
Tokenize STRING005
Backup Len(String(INTEGER005))
Print String(INTEGER003)
STRING005 = Trim(Strip(GetToken(), "-"), """")
If (STRING005 <> "") Then
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, Mid(STRING005, 1, 3), 3
FWrite 1, Mid(STRING005, 4, 3), 4
FWrite 1, Mid(STRING005, 7, 4), 8
STRING008 = Replace(Trim(GetToken(), """"), Chr(255), " ")
FWrite 1, STRING008, 25
STRING005 = Trim(GetToken(), """")
FWrite 1, ToDate(STRING005), 2
FWrite 1, 0, 4
FWrite 1, Space(11), 11
INTEGER005 = INTEGER003
Inc INTEGER003
Endif
Goto LABEL009
:LABEL010
FClose 1
FClose 2
PrintLn
PrintLn "@X0B" + STRING002 + " successfully imported..."
Log STRING002 + " imported into Used # file...", 0
PrintLn
Gosub LABEL040
Return
:LABEL011
Gosub LABEL042
PrintLn
STRING008 = ""
STRING002 = ""
InputStr "Path & Filename of file to import", STRING002, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 8
STRING002 = Strip(STRING002, " ")
If (STRING002 == "") Goto LABEL048
STRING001 = Upper(STRING001)
PrintLn
If (Exist(STRING002)) Goto LABEL012
PrintLn "@X0C" + STRING002 + " does not exist!"
PrintLn
Delay 9
Return
:LABEL012
If (Exist(STRING001)) Then
FOpen 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
Else
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
Endif
FOpen 2, STRING002, 0, 0
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FAlready Used # Trash File Importation Procedure@X0A)"
PrintLn
PrintLn "@X0EFrom : @X0F" + STRING002
PrintLn "@X0ETo : @X0F" + STRING001
PrintLn "@X0EFilter Type : @X0FCSVERIFY"
PrintLn
PrintLn
Print "@X0CImporting record #@X0F1"
INTEGER003 = 1
INTEGER005 = 1
:LABEL013
If (Ferr(2)) Goto LABEL014
FGet 2, STRING005
Tokenize STRING005
Backup Len(String(INTEGER005))
Print String(INTEGER003)
STRING005 = GetToken() + Strip(GetToken(), "-")
If (STRING005 <> "") Then
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, Mid(STRING005, 1, 3), 3
FWrite 1, Mid(STRING005, 4, 3), 4
FWrite 1, Mid(STRING005, 7, 4), 8
GetToken STRING005
GetToken STRING005
STRING008 = ""
GetToken STRING005
While (STRING005 <> "ON") Do
STRING008 = STRING008 + STRING005 + " "
GetToken STRING005
EndWhile
FWrite 1, Trim(STRING008, " "), 25
GetToken STRING005
FWrite 1, ToDate(STRING005), 2
GetToken STRING005
GetToken STRING005
FWrite 1, ToTime(STRING005), 4
FWrite 1, Space(11), 11
INTEGER005 = INTEGER003
Inc INTEGER003
Endif
Goto LABEL013
:LABEL014
FClose 1
FClose 2
PrintLn
PrintLn "@X0B" + STRING002 + " successfully imported..."
Log STRING002 + " imported into Used # file...", 0
PrintLn
Gosub LABEL040
Return
:LABEL015
Gosub LABEL042
BOOLEAN002 = 0
BYTE002 = 20
BYTE003 = 110
STRING007 = Trim(ReadLine(PCBDat(), 29), " ")
:LABEL016
If (BOOLEAN002) Goto LABEL017
PrintLn
PrintLn "@X0FLoopUtil Trash File Building Facility"
PrintLn "@X0CNOTE : NUMBERS MUST HAVE 10 CHARACTERS TO BE PROCESSED!"
PrintLn " INTERNATIONAL NUMBERS OR INCOMPLETE NUMBERS WILL NOT BE PROCESSED..."
PrintLn " See BUILD.RPT after building process for records"
PrintLn " to manually update."
PrintLn
PrintLn " @X0F(@X09L@X0F)@X0Bowest sec. level to process : @X0E" + String(BYTE002)
PrintLn " @X0F(@X09H@X0F)@X0Bighest sec. level to process : @X0E" + String(BYTE003)
PrintLn " @X0F(@X09U@X0F)@X0Bsers file path & filename : @X0E(See Below)"
PrintLn " " + STRING007
PrintLn
PrintLn " @X0F(@X09B@X0F)@X0Build trash file"
PrintLn " @X0F(@X09Q@X0F)@X0Buit to LoopUtil main"
PrintLn
STRING004 = ""
InputStr "Trash File Building Facility Command", STRING004, 10, 1, "LlHhBbQqUu", 2 + 4
Newline
STRING004 = Upper(STRING004)
Select Case (STRING004)
Case "Q"
Goto LABEL048
Case "B"
BOOLEAN002 = 1
Case "L"
InputInt "Lowest Security level of users (phone numbers) to place in trash file", BYTE002, 10
Case "H"
InputInt "Highest Security level of users (phone numbers) to place in trash file", BYTE003, 10
Case "U"
PrintLn "@X0AEnter path & filename to your USERS file below..."
InputStr "", STRING007, 12, 75, Mask_Path() + Mask_File(), 2 + 4
Newline
End Select
Goto LABEL016
:LABEL017
Cls
PrintLn
PrintLn Space(11) + "@X0F(@X0ALoopBack Already Used Number Trash File Building Process@X0F)"
PrintLn
PrintLn
INTEGER001 = FileInf(STRING007, 4)
INTEGER002 = INTEGER001 / 400
INTEGER003 = 1
PrintLn "@X0ABacking up trash file..."
If (Exist(PPEPath() + "TRASH.BAK")) Delete PPEPath() + "TRASH.BAK"
If (BOOLEAN006) Goto LABEL018
If (Exist(STRING001)) Rename STRING001, PPEPath() + "TRASH.BAK"
Goto LABEL019
:LABEL018
If (Exist(STRING001)) Copy STRING001, PPEPath() + "TRASH.BAK"
:LABEL019
PrintLn "@X0AOpening files..."
KbdChkOff
FCreate 2, PPEPath() + "BUILD.RPT", 1, 2
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0FBUILD.RPT @X0Cfile is currently inaccessible..."
PrintLn "@X0AA report will not be generated... @X0CResuming..."
FClose 2
Else
FPutLn 2, "LoopBack v5.05 Trash File Building Report"
FPutLn 2, "Generated on file " + STRING007 + " on " + String(Date()) + " at " + String(Time())
FPutLn 2, "================================================================================"
FPutLn 2
Endif
BOOLEAN001 = 0
If (BOOLEAN006) Goto LABEL020
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack v5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
Goto LABEL021
:LABEL020
If (Exist(STRING001)) Then
FOpen 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
Else
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
Endif
:LABEL021
PrintLn
PrintLn "@X0AReading user records & building trashfile..."
PrintLn "@X0F File Size = " + String(INTEGER001) + " bytes Number of Records = " + String(INTEGER002)
PrintLn
If (OnLocal()) Then
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE001 = GetY()
Else
Print "Fetching records... "
Endif
INTEGER001 = 1
While (INTEGER003 <= INTEGER002) Do
GetAltUser INTEGER003
If ((U_Sec >= BYTE002) && (U_Sec <= BYTE003)) Then
BOOLEAN005 = 1
Else
BOOLEAN005 = 0
Endif
If (BOOLEAN005) Then
STRING008 = U_BDPhone
STRING008 = Strip(Strip(Strip(Strip(Strip(Strip(STRING008, " "), "-"), ")"), "("), "."), ",")
FPutLn 2, "--------------------------------------------------"
FPutLn 2, U_Name() + " Record #" + String(INTEGER003)
If (Len(STRING008) == 10) Then
STRING009 = Mid(STRING008, 1, 3)
STRING011 = Mid(STRING008, 4, 3)
STRING010 = Mid(STRING008, 7, 4)
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, STRING009, 3
FWrite 1, STRING011, 4
FWrite 1, STRING010, 8
FWrite 1, U_Name(), 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
FPutLn 2, "USA DATA number detected... Added to trash file..."
Goto LABEL022
Endif
FPutLn 2, "Invalid DATA number format... Please add manually..."
FPutLn 2, "DATA # = " + U_BDPhone
:LABEL022
STRING008 = U_HVPhone
STRING008 = Strip(Strip(Strip(Strip(Strip(Strip(STRING008, " "), "-"), ")"), "("), "."), ",")
If (Len(STRING008) == 10) Then
STRING009 = Mid(STRING008, 1, 3)
STRING011 = Mid(STRING008, 4, 3)
STRING010 = Mid(STRING008, 7, 4)
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, STRING009, 3
FWrite 1, STRING011, 4
FWrite 1, STRING010, 8
FWrite 1, U_Name(), 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
FPutLn 2, "USA HOME number detected... Added to trash file..."
Goto LABEL023
Endif
FPutLn 2, "Invalid HOME number format... Please add manually..."
FPutLn 2, "HOME # = " + U_HVPhone
Endif
:LABEL023
If (OnLocal()) Then
Gosub LABEL045
Else
Gosub LABEL046
Endif
INTEGER001 = INTEGER003
Inc INTEGER003
EndWhile
PrintLn
PrintLn "@X0FTrash file building finished! Closing files..."
FClose 1
FClose 2
Gosub LABEL040
Delay 4
KbdChkOn
Return
:LABEL024
PrintLn
PrintLn "@X07LoopUtil provides the ability to check the user's in your LoopBack trash "
PrintLn "file against those in your USERS file. If a user in your LoopBack trash file"
PrintLn "is not found in your PCBoard USERS file, he/she will be flagged for deletion"
PrintLn "from the LoopBack trash file and packed out during the packing process. You"
PrintLn "have the choice whether or not you want LoopBack to do this."
PrintLn
STRING005 = YesChar()
InputYN "Would you like to purge inactive users from the trash file", STRING005, 10
If (Upper(STRING005) == YesChar()) Then
BOOLEAN007 = 1
Else
BOOLEAN007 = 0
Endif
Gosub LABEL042
If (Exist(STRING001)) Goto LABEL025
PrintLn
PrintLn "@X0C" + STRING001 + " does not exist!"
Delay 9
Return
:LABEL025
INTEGER001 = FileInf(STRING001, 4)
INTEGER002 = (INTEGER001 - 37) / 59
If (INTEGER002 <= 1) Then
PrintLn
PrintLn "@X0CTHERE MUST BE AT LEAST ONE RECORD PRESENT IN THE TRASH CAN FILE!"
PrintLn
Delay 18
Return
Endif
KbdChkOff
Cls
PrintLn
PrintLn Space(11) + "@X0F(@X0ALoopBack Already Used Number Trash File Packing Process@X0F)"
If (BOOLEAN007) Gosub LABEL029
Rename STRING001, PPEPath() + String(PcbNode()) + "ts.$$$"
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FOpen 2, PPEPath() + String(PcbNode()) + "ts.$$$", 0, 3
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + String(PcbNode()) + "ts.$$$ @X0Cfile is currently inaccessible..."
FClose 2
FClose 1
PrintLn
PrintLn "@X0ADeleting & renaming temporary files..."
Delete STRING001
Rename PPEPath() + String(PcbNode()) + "ts.$$$", STRING001
Return
Endif
BOOLEAN002 = 0
FSeek 1, 0, 0
FWrite 1, " Loopback 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
PrintLn
If (BOOLEAN007) Goto LABEL026
PrintLn
PrintLn "@X0F File Size = " + String(INTEGER001) + " bytes Number of Records = " + String(INTEGER002)
PrintLn
:LABEL026
Print "@X0FPacking trash can file... "
If (OnLocal()) Then
PrintLn
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE001 = GetY()
Endif
INTEGER003 = 1
FSeek 2, 37, 0
While (INTEGER003 <= INTEGER002) Do
BOOLEAN002 = 0
TBOOLEAN003(0) = 0
TBOOLEAN003(1) = 0
STRING009 = ""
STRING011 = ""
STRING010 = ""
STRING002 = ""
DATE001 = 0
TIME001 = 0
FRead 2, TBOOLEAN003(0), 1
If (TBOOLEAN003(0)) Then
BOOLEAN002 = 1
Else
BOOLEAN002 = 0
Endif
If (BOOLEAN002) Goto LABEL027
FWrite 1, TBOOLEAN003(0), 1
FRead 2, TBOOLEAN003(1), 1
FWrite 1, TBOOLEAN003(1), 1
FRead 2, STRING009, 3
FWrite 1, STRING009, 3
FRead 2, STRING011, 4
FWrite 1, STRING011, 4
FRead 2, STRING010, 8
FWrite 1, STRING010, 8
FRead 2, STRING002, 25
FWrite 1, STRING002, 25
FRead 2, DATE001, 2
FWrite 1, DATE001, 2
FRead 2, TIME001, 4
FWrite 1, TIME001, 4
FSeek 2, 11, 1
FWrite 1, Space(11), 11
Goto LABEL028
:LABEL027
FSeek 2, 58, 1
:LABEL028
If (OnLocal()) Then
Gosub LABEL045
Else
Gosub LABEL046
Endif
Inc INTEGER003
EndWhile
Color 7
FClose 1
FClose 2
PrintLn
PrintLn
PrintLn "@X0EChecking files..."
Delete PPEPath() + String(PcbNode()) + "ts.$$$"
INTEGER001 = FileInf(STRING001, 4)
INTEGER002 = (INTEGER001 - 37) / 59
If (INTEGER002 < 1) Then
PrintLn
PrintLn "@X0C0 byte file! Recreating with a dummy record..."
FCreate 1, STRING001, 1, 2
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, "000", 3
FWrite 1, "000", 3
FWrite 1, "0000", 4
FWrite 1, "JOHN DOE", 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
FClose 1
PrintLn "@X0ANew trash file successfully created..."
Endif
Gosub LABEL040
Log "LoopBack Trash can file successfully packed!", 0
KbdChkOn
Return
:LABEL029
FCreate 4, PPEPath() + "COMPARE.RPT", 1, 2
FPutLn 4, "LoopBack v5.05 USERS file vs. Trash file comparing report"
FPutLn 4, "Compiled on " + String(Date()) + " at " + String(Time())
FPutLn 4, "--------------------------------------------------------------------"
FPutLn 4
INTEGER006 = 0
STRING007 = ReadLine(PCBDat(), 28)
FClose -1
Rename STRING001, PPEPath() + String(PcbNode()) + "tsc.$$$"
FCreate 1, STRING001, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 4
Return
Endif
FOpen 2, PPEPath() + String(PcbNode()) + "tsc.$$$", 0, 3
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + String(PcbNode()) + "tsc.$$$ @X0Cfile is currently inaccessible..."
FClose 4
FClose 2
FClose 1
PrintLn
PrintLn "@X0ADeleting & renaming temporary files..."
Delete STRING001
Rename PPEPath() + String(PcbNode()) + "tsc.$$$", STRING001
Return
Endif
BOOLEAN002 = 0
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
PrintLn
PrintLn "@X0F File Size = " + String(INTEGER001) + " bytes Number of Records = " + String(INTEGER002)
PrintLn
Print "@X0FComparing trash can file against USERS file... "
If (OnLocal()) Then
PrintLn
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE001 = GetY()
Endif
INTEGER003 = 1
FSeek 2, 37, 0
FDefOut 1
While (INTEGER003 <= INTEGER002) Do
BOOLEAN002 = 0
FRead 2, TBOOLEAN003(0), 1
FRead 2, TBOOLEAN003(1), 1
FRead 2, STRING009, 3
FRead 2, STRING011, 4
FRead 2, STRING010, 8
FRead 2, STRING002, 25
BOOLEAN008 = 0
Gosub LABEL030
If (BOOLEAN008) Then
FRead 2, DATE001, 2
FRead 2, TIME001, 4
FSeek 2, 11, 1
FDWrite TBOOLEAN003(0), 1
FDWrite TBOOLEAN003(1), 1
FDWrite STRING009, 3
FDWrite STRING011, 4
FDWrite STRING010, 8
FDWrite STRING002, 25
FDWrite DATE001, 2
FDWrite TIME001, 4
FDWrite Space(11), 11
Else
FSeek 2, 17, 1
Endif
If (OnLocal()) Then
Gosub LABEL045
Else
Gosub LABEL046
Endif
Inc INTEGER003
EndWhile
Color 7
FClose 1
FClose 2
FClose 4
PrintLn
PrintLn
PrintLn "@X0EChecking files..."
Delete PPEPath() + String(PcbNode()) + "tsc.$$$"
INTEGER001 = FileInf(STRING001, 4)
INTEGER002 = (INTEGER001 - 37) / 59
If (INTEGER002 < 1) Then
PrintLn
PrintLn "@X0C0 byte file! Recreating with a dummy record..."
FCreate 1, STRING001, 1, 2
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, "000", 3
FWrite 1, "000", 3
FWrite 1, "0000", 4
FWrite 1, "JOHN DOE", 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
FClose 1
PrintLn "@X0ANew trash file successfully created..."
Endif
PrintLn "@X0F" + String(INTEGER006) + " name(s) was/were removed from the trash file for inactivity!"
Log String(INTEGER006) + " inactive users removed from LoopBack Trash file", 0
Return
:LABEL030
STRING002 = Trim(Upper(STRING002), " ")
If (U_RecNum(STRING002) == -1) Then
BOOLEAN008 = 0
Inc INTEGER006
FPutLn 4, STRING002 + " was deleted from the trash file..."
Else
BOOLEAN008 = 1
Endif
Return
:LABEL031
BOOLEAN002 = 0
BOOLEAN004 = 1
Gosub LABEL042
If (Exist(PPEPath() + "TRASH.IDX")) Goto LABEL032
Cls
PrintLn
PrintLn Space(29) + "@X0F(@X0ABuilding Index File@X0F)"
PrintLn
Gosub LABEL040
:LABEL032
INTEGER001 = FileInf(STRING001, 4)
If (Exist(STRING001)) Goto LABEL033
PrintLn
PrintLn "@X0CCreating sample " + STRING001
BOOLEAN001 = 1
FCreate 1, STRING001, 2, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, "000", 3
FWrite 1, "000", 4
FWrite 1, "0000", 8
FWrite 1, "JOHN DOE", 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
INTEGER001 = 96
Goto LABEL034
:LABEL033
BOOLEAN001 = 1
FOpen 1, STRING001, 2, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
:LABEL034
FOpen 2, PPEPath() + "TRASH.IDX", 1, 2
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + PPEPath() + "TRASH.IDX @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
PrintLn
Return
Endif
INTEGER003 = 1
STRING003 = ""
:LABEL035
If (BOOLEAN002) Goto LABEL037
If (BOOLEAN004) Then
FSeek 1, 37 + INTEGER003 * 59 - 59, 0
FRead 1, TBOOLEAN003(0), 1
FRead 1, TBOOLEAN003(1), 1
FRead 1, STRING009, 3
FRead 1, STRING011, 4
FRead 1, STRING010, 8
STRING009 = Strip(STRING009, " ")
STRING011 = Strip(STRING011, " ")
STRING010 = Strip(STRING010, " ")
FRead 1, STRING002, 25
FRead 1, DATE001, 2
FRead 1, TIME001, 4
BOOLEAN004 = 0
Endif
PrintLn
INTEGER002 = (INTEGER001 - 37) / 59
PrintLn " @X0BRecord #@X0E" + String(INTEGER003) + "@X0B of @X0E" + String(INTEGER002)
Print " @X0ADeleted : @X0C"
If (TBOOLEAN003(0)) Then
PrintLn "Yes"
Else
PrintLn "No "
Endif
PrintLn
PrintLn " @X0F(@X09N@X0F)@X0Fame : @X0C" + STRING002
Print " @X0F(@X09#@X0F)@X0F called : @X0C"
If (TBOOLEAN003(1)) Then
Print STRING009 + "-" + STRING011 + "-" + STRING010
Else
Print STRING009 + "-" + Mid(STRING011, 1, 3) + "-" + Mid(STRING010, 1, 4)
Endif
Print " @X0F(@X09I@X0F)@X0Fnternational : @X0C"
If (TBOOLEAN003(1)) Then
PrintLn "Yes"
Else
PrintLn "No "
Endif
PrintLn " @X0F(@X09D@X0F)@X0Fate : @X0C" + String(DATE001)
PrintLn " @X0F(@X09T@X0F)@X0Fime : @X0C" + String(TIME001)
PrintLn
PrintLn " @X0F(@X09+@X0F) @X0BAdvance 1 record @X0F(@X09-@X0F) @X0BRetard 1 record"
PrintLn " @X0F(@X09J@X0F)@X0Bump to record @X0F(@X09A@X0F)@X0Bdd a record"
PrintLn " @X0F(@X09E@X0F)@X0Brase toggle @X0F(@X09Q@X0F)@X0Buit"
PrintLn " @X0F(@X09S@X0F)@X0Bearch for text"
PrintLn
InputStr "(H)elp, Enter command", STRING003, 10, 1, "SsNn#IiTtDdJjAaEeQq+-Hh", 2 + 4
Newline
STRING003 = Upper(STRING003)
Select Case (STRING003)
Case "Q"
FClose 1
BOOLEAN004 = 0
BOOLEAN002 = 1
Case "H"
Print "@PON@"
DispFile PPEPath() + "LBKNE", 1 + 4
Print "@POFF@"
Cls
BOOLEAN004 = 0
BOOLEAN002 = 0
Case "S"
Gosub LABEL038
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "+"
If (INTEGER003 >= INTEGER002) Then
INTEGER003 = 1
Else
Inc INTEGER003
Endif
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "-"
If (INTEGER003 <= 1) Then
INTEGER003 = INTEGER002
Else
Dec INTEGER003
Endif
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "J"
INTEGER005 = INTEGER002
InputInt "Enter record # to jump to", INTEGER005, 10
If (INTEGER005 > INTEGER002) Then
INTEGER003 = INTEGER002
ElseIf (INTEGER005 < 1) Then
INTEGER003 = 1
Else
INTEGER003 = INTEGER005
Endif
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "E"
FSeek 1, 37 + INTEGER003 * 59 - 59, 0
If (TBOOLEAN003(0)) Then
FWrite 1, 0, 1
Else
FWrite 1, 1, 1
Endif
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "A"
STRING002 = ""
InputStr "Enter name", STRING002, 10, 25, Mask_Ascii(), 2 + 4
STRING002 = Upper(STRING002)
Newline
DATE001 = Date()
InputDate "Enter date", DATE001, 10
Newline
TIME001 = Time()
InputTime "Enter time", TIME001, 10
Newline
STRING005 = NoChar()
InputYN "International number", STRING005, 10
Newline
If (Upper(STRING005) == Upper(YesChar())) Then
TBOOLEAN003(1) = 1
Else
TBOOLEAN003(1) = 0
Endif
If (TBOOLEAN003(1)) Then
InputStr "Country Code", STRING009, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "City Code", STRING011, 9, 4, Mask_Num(), 2 + 4
Newline
InputStr "Number", STRING010, 9, 8, Mask_Num() + "-,() ", 2 + 4
Else
InputStr "Area Code", STRING009, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "Prefix", STRING011, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "Number", STRING010, 9, 4, Mask_Num(), 2 + 4
Endif
STRING009 = Strip(STRING009, " ")
STRING011 = Strip(STRING011, " ")
STRING010 = Strip(Strip(Strip(Strip(Strip(STRING010, " "), "-"), ","), "("), ")")
Newline
STRING004 = YesChar()
InputYN STRING009 + "-" + STRING011 + "-" + STRING010 + " Is this correct", STRING004, 12
If (Upper(STRING004) == Upper(YesChar())) Then
FSeek 1, 0, 2
FSeek 2, 0, 2
FWrite 1, 0, 1
FWrite 1, TBOOLEAN003(1), 1
FWrite 1, STRING009, 3
FWrite 1, STRING011, 4
FWrite 1, STRING010, 8
FWrite 1, STRING002, 25
FWrite 1, DATE001, 2
FWrite 1, TIME001, 4
FWrite 1, Space(11), 11
INTEGER004 = S2I(STRING009, 10) + S2I(STRING011, 10) + S2I(STRING010, 10)
FWrite 2, INTEGER002 + 1, 4
FWrite 2, INTEGER004, 4
INTEGER002 = INTEGER002 + 1
INTEGER001 = INTEGER001 + 59
INTEGER003 = INTEGER002
Endif
BOOLEAN004 = 1
BOOLEAN002 = 0
Case "T"
InputTime "Enter new time", TIME001, 10
FSeek 1, 37 + INTEGER003 * 59 - 15, 0
FWrite 1, TIME001, 4
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "D"
InputDate "Enter new date", DATE001, 10
FSeek 1, 37 + INTEGER003 * 59 - 17, 0
FWrite 1, DATE001, 2
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "#"
If (TBOOLEAN003(1)) Then
InputStr "Country Code", STRING009, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "City Code", STRING011, 9, 4, Mask_Num(), 2 + 4
Newline
InputStr "Number", STRING010, 9, 8, Mask_Num() + "-,() ", 2 + 4
Else
InputStr "Area Code", STRING009, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "Prefix", STRING011, 9, 3, Mask_Num(), 2 + 4
Newline
InputStr "Number", STRING010, 9, 4, Mask_Num(), 2 + 4
Endif
STRING009 = Strip(STRING009, " ")
STRING011 = Strip(STRING011, " ")
STRING010 = Strip(Strip(Strip(Strip(Strip(STRING010, " "), "-"), ","), "("), ")")
FSeek 1, 37 + INTEGER003 * 59 - 57, 0
If (TBOOLEAN003(1)) Then
FWrite 1, STRING009, 3
FWrite 1, STRING011, 4
FWrite 1, STRING010, 8
Else
FWrite 1, STRING009, 3
FWrite 1, STRING011 + Space(1), 4
FWrite 1, STRING010 + Space(4), 8
Endif
INTEGER004 = S2I(STRING009, 10) + S2I(STRING011, 10) + S2I(STRING010, 10)
FSeek 2, 37 + INTEGER003 * 8 - 4, 0
FWrite 2, INTEGER004, 4
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "N"
InputStr "Enter new name", STRING002, 10, 25, Mask_Ascii(), 2 + 4
STRING002 = Upper(STRING002)
FSeek 1, 37 + INTEGER003 * 59 - 42, 0
FWrite 1, STRING002, 25
BOOLEAN002 = 0
BOOLEAN004 = 1
Case "I"
STRING005 = NoChar()
InputYN "International Number", STRING005, 10
If (Upper(STRING005) == Upper(YesChar())) Then
TBOOLEAN003(1) = 1
Goto LABEL036
Endif
TBOOLEAN003(1) = 0
:LABEL036
FSeek 1, 37 + INTEGER003 * 59 - 58, 0
FWrite 1, TBOOLEAN003(1), 1
BOOLEAN002 = 0
BOOLEAN004 = 1
STRING005 = ""
End Select
Goto LABEL035
:LABEL037
FClose 1
FClose 2
PrintLn
STRING005 = YesChar()
InputYN "Reindex Used # Trash File", STRING005, 12
Newline
If (Upper(STRING005) == YesChar()) Gosub LABEL040
Return
:LABEL038
PrintLn
PrintLn "@X0FEnter text to search for below (Searching name field)"
InputText "", STRING006, 15, 75
Newline
STRING006 = Trim(STRING006, " ")
If (STRING006 == "") Then
PrintLn "@X0CSearch aborted... Returning to already used # editor..."
BOOLEAN005 = 0
Return
Endif
PrintLn "@X0AInitializing search..."
SearchInit STRING006, 0
Print "@X0FSearching record #@X0B" + String(INTEGER003) + "@X0F of @X0B" + String(INTEGER002)
INTEGER005 = INTEGER003
INTEGER004 = INTEGER003
FSeek 1, 37 + INTEGER003 * 59 - 59, 0
While (INTEGER003 <= INTEGER002) Do
FSeek 1, 17, 1
FRead 1, STRING005, 25
FSeek 1, 17, 1
Backup Len(String(INTEGER002) + " of " + String(INTEGER004))
Print "@X0B" + String(INTEGER003) + "@X0F of @X0B" + String(INTEGER002)
SearchFind STRING005, BOOLEAN005
If (BOOLEAN005 && (INTEGER003 <> INTEGER005)) Then
PrintLn
PrintLn "@X0ASearch Criteria was found! Now displaying..."
SearchStop
Return
Else
BOOLEAN005 = 0
Endif
INTEGER004 = INTEGER003
Inc INTEGER003
EndWhile
If (BOOLEAN005) Goto LABEL039
PrintLn
PrintLn "@X0CSearch criteria was not found... Returning to record #" + String(INTEGER005)
INTEGER003 = INTEGER005
SearchStop
:LABEL039
Return
:LABEL040
Gosub LABEL042
If (Exist(STRING001)) Goto LABEL041
PrintLn
PrintLn "@X0CCreating sample " + STRING001
FCreate 1, STRING001, 2, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Binary Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
FWrite 1, 0, 1
FWrite 1, 0, 1
FWrite 1, "000", 3
FWrite 1, "000", 4
FWrite 1, "0000", 8
FWrite 1, "JOHN DOE", 25
FWrite 1, Date(), 2
FWrite 1, Time(), 4
FWrite 1, Space(11), 11
FClose 1
:LABEL041
INTEGER001 = FileInf(STRING001, 4)
INTEGER002 = (INTEGER001 - 37) / 59
FOpen 1, STRING001, 0, 0
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 1
PrintLn
Return
Endif
FCreate 2, PPEPath() + "TRASH.IDX", 1, 3
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + PPEPath() + "TRASH.IDX @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
PrintLn
Return
Endif
FWrite 2, " LoopBack 5.05 Trash File Index " + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 37
INTEGER003 = 1
PrintLn
Print "Generating index file... "
If (OnLocal()) Then
PrintLn
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE001 = GetY()
Endif
FSeek 1, 37, 0
While (INTEGER003 <= INTEGER002) Do
FSeek 1, 2, 1
FRead 1, STRING009, 3
FRead 1, STRING011, 4
FRead 1, STRING010, 8
FSeek 1, 42, 1
INTEGER004 = S2I(STRING009, 10) + S2I(STRING011, 10) + S2I(STRING010, 10)
FWrite 2, INTEGER003, 4
FWrite 2, INTEGER004, 4
If (OnLocal()) Then
Gosub LABEL045
Else
Gosub LABEL046
Endif
Inc INTEGER003
EndWhile
PrintLn
PrintLn "@X0AAlready used number file indexes successfully created!"
Log "LoopBack used # trash index created...", 0
FClose 1
FClose 2
Return
:LABEL042
STRING005 = PPEPath() + "LBKBACK.XXX"
If (Exist(PPEPath() + "LBKBACK.XXX")) Then
FOpen 2, STRING005, 0, 0
Else
PrintLn
PrintLn "@X0FPath & filename to LoopBack config file @X0E(Enter Below)"
InputStr "", STRING005, 12, 75, Mask_Path() + Mask_File(), 2 + 4
If (Exist(STRING005)) Goto LABEL043
PrintLn
PrintLn "@X0C" + STRING005 + " DOES NOT EXIST! @X0AReturning to LoopUtil Main..."
Goto LABEL048
Goto LABEL044
:LABEL043
FOpen 2, STRING005, 0, 0
Endif
:LABEL044
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING005 + " @X0Cfile is currently inaccessible..."
FClose 2
Return
Endif
FSeek 2, 284, 0
FRead 2, STRING001, 75
FClose 2
Return
:LABEL045
If (INTEGER003 == 1) BYTE006 = 0
If ((INTEGER003 <> 0) && (INTEGER002 <> 0)) Then
REAL002 = ToReal(INTEGER003) / ToReal(INTEGER002)
REAL003 = FmtReal(ToReal(35) * REAL002, 1, 0)
BYTE005 = ToByte(REAL003) - BYTE006
If (BYTE005 <> BYTE006) Then
Color 63
AnsiPos 4 + BYTE006, BYTE001
For BYTE006 = 1 To BYTE005
Print "░"
Next
BYTE006 = ToByte(REAL003)
REAL002 = FmtReal(REAL002 * 100, 1, 0)
BYTE005 = (43 - Len(String(REAL002) + "%")) / 2
Color 11
REAL003 = ToReal(BYTE001) - 1
AnsiPos BYTE005, ToByte(REAL003)
Print String(REAL002) + "%"
AnsiPos 45, BYTE001
Endif
Endif
Return
:LABEL046
If ((INTEGER003 <> 0) && (INTEGER002 <> 0)) Then
If (INTEGER003 == 1) Then
BYTE004 = 0
Goto LABEL047
Endif
BYTE004 = REAL001
:LABEL047
REAL001 = ToReal(INTEGER003) / ToReal(INTEGER002)
REAL001 = FmtReal(REAL001 * 100, 1, 0)
If (BYTE004 <> REAL001) Then
Backup Len(String(BYTE004) + "%")
Print String(REAL001) + "%"
Endif
Endif
Return
:LABEL048
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 1 End
; 8 Cls
; 1 Wait
; 4 Color
; 292 Goto
; 260 Let
; 27 Print
; 242 PrintLn
; 177 If
; 1 DispFile
; 16 FCreate
; 15 FOpen
; 2 FAppend
; 69 FClose
; 3 FGet
; 27 FPutLn
; 5 Delete
; 7 Log
; 24 InputStr
; 5 InputYN
; 3 InputInt
; 2 InputDate
; 2 InputTime
; 36 Gosub
; 49 Return
; 9 Delay
; 11 Inc
; 1 Dec
; 20 Newline
; 2 Tokenize
; 10 GetToken
; 1 InputText
; 2 KbdChkOn
; 2 KbdChkOff
; 3 AnsiPos
; 5 Backup
; 5 Rename
; 34 FSeek
; 33 FRead
; 128 FWrite
; 1 FDefOut
; 9 FDWrite
; 1 Copy
; 1 GetAltUser
; 1 SearchInit
; 1 SearchFind
; 2 SearchStop
;
;
; ■ Functions used :
;
; 2 -
; 12 *
; 10 /
; 323 +
; 18 -
; 45 ==
; 11 <>
; 4 <
; 10 <=
; 1 >
; 4 >=
; 166 !
; 6 &&
; 1 ||
; 8 Len(
; 21 Upper()
; 17 Mid()
; 2 Left()
; 23 Space()
; 32 Ferr()
; 62 Chr()
; 9 Trim()
; 11 Date()
; 11 Time()
; 3 U_Name()
; 2 NoChar()
; 8 YesChar()
; 3 Replace()
; 44 Strip()
; 49 String()
; 12 Mask_Num()
; 7 Mask_File()
; 7 Mask_Path()
; 3 Mask_Ascii()
; 2 PCBDat()
; 24 PPEPath()
; 10 PcbNode()
; 2 ReadLine()
; 8 OnLocal()
; 5 GetToken()
; 19 Exist()
; 9 S2I()
; 4 GetY()
; 7 FileInf()
; 1 U_RecNum()
; 3 ToByte()
; 2 ToDate()
; 6 ToReal()
; 1 ToTime()
; 3 FmtReal()
;
;------------------------------------------------------------------------------
;
; Analysis flags : Rd
;
; R - Read user ■ 5
; User records are read, this may signify that someone wants to get
; various informations about a user (for example his password), but
; this may also be normal for a program accessing user records (for
; example a User Editor)
; ■ Search for : GETALTUSER
;
; d - Access PCBOARD.DAT ■ 2
; Program gets the full pathname to PCBOARD.DAT, this may be usefull
; for many PPE so they can find various informations on the system
; (system paths, max number of lines in messages, ...) but it may also
; be a way to gather vital informations.
; ■ Search for : PCBDAT()
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 1 For/Next
; 7 While/EndWhile
; 111 If/Then or If/Then/Else
; 4 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------